home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1996 March / macformat-035.iso / Shareware City / Developers / ICAppSourceKit1.2 / ICButtonWhat.p < prev    next >
Encoding:
Text File  |  1995-11-07  |  5.6 KB  |  231 lines  |  [TEXT/CWIE]
  1. unit ICButtonWhat;
  2.  
  3. interface
  4.  
  5.     uses
  6.         ICWindowGlobals;
  7.  
  8.     function WhatOpenButton (wt: WindowType; item: integer): OSErr;
  9.     function WhatClickButton (wt: WindowType; item: integer; er: eventRecord): OSErr;
  10.  
  11. implementation
  12.  
  13.     uses
  14.         Traps, Icons, Dialogs, Fonts, ICStrH, OSSubs, 
  15.  
  16.         ICKeys, ICAPI, ICSubs, ICDialogs, ICMiscSubs, ICSubs, ICDocument {X}, ICGlobals, ICWindows {X};
  17.  
  18.     procedure HackDeviceLoop (drawingRgn: RgnHandle; drawingProc: DeviceLoopDrawingProcPtr; userData: LONGINT; flags: longint);
  19.     inline
  20.         $ABCA;
  21.  
  22.     procedure GetIconRect (dlg: DialogPtr; item: integer; var r: Rect);
  23.         var
  24.             width: integer;
  25.     begin
  26.         GetDItemRect(dlg, item, r);
  27.         width := r.right - r.left;
  28.         r.right := r.left + 32;
  29.         r.bottom := r.top + 32;
  30.         OffsetRect(r, (width - 32) div 2, 8);
  31.     end; (* GetIconRect *)
  32.  
  33.     var
  34.         button_highlighted: boolean;
  35.  
  36.     procedure ButtonDeviceLoopProc (depth: integer; deviceFlags: integer; targetDevice: GDHandle; item: longint);
  37.         var
  38.             dlg: DialogPtr;
  39.             r: Rect;
  40.             width: integer;
  41.             colour: RGBColor;
  42.             font_info: FontInfo;
  43.             boundary_rect: Rect;
  44.             icon_rect: Rect;
  45.     begin
  46.         deviceFlags := deviceFlags; { Unused }
  47.         targetDevice := targetDevice; { Unused }
  48.         GetPort(dlg);
  49.         PenNormal;
  50.         GetDItemRect(dlg, item, r);
  51.         if button_highlighted then begin
  52.             if depth = 1 then begin
  53.                 PaintRect(r);
  54.             end else begin
  55.                 colour.red := lowrd(16000);     (* 8520 *)
  56.                 colour.green := lowrd(16000);
  57.                 colour.blue := lowrd(16000);
  58.                 RGBBackColor(colour);
  59.                 EraseRect(r);
  60.                 BackColor(whiteColor);
  61.             end; (* if *)
  62.         end else begin
  63.             if depth = 1 then begin
  64.                 EraseRect(r);
  65.             end else begin
  66.                 colour.red := lowrd(57015);
  67.                 colour.green := lowrd(57015);
  68.                 colour.blue := lowrd(57015);
  69.                 RGBBackColor(colour);
  70.                 EraseRect(r);
  71.                 BackColor(whiteColor);
  72.             end; (* if *)
  73.         end; (* if *)
  74.         FrameRect(r);
  75.         GetIconRect(dlg, item, icon_rect);
  76.         boundary_rect := icon_rect;
  77.         InsetRect(boundary_rect, -4, -4);
  78.         EraseRect(boundary_rect);
  79.         FrameRect(boundary_rect);
  80.         DrawIcon(200 + item, icon_rect, button_highlighted);
  81.         TextFont(applFont);
  82.         TextSize(9);
  83.         GetFontInfo(font_info);
  84.         width := StringWidth(GetAString(130, item));
  85.         MoveTo((r.left + (r.right - r.left) div 2) - (width div 2), r.bottom - 2 - font_info.descent);
  86.         if button_highlighted then begin
  87.             TextMode(srcBic);
  88.         end; (* if *)
  89.         DrawString(GetAString(130, item));
  90.         TextMode(srcOr);
  91.     end; (* ButtonDeviceLoopProc *)
  92.  
  93.     procedure DrawButton (dlg: DialogPtr; item: integer; highlighted: boolean);
  94.         var
  95.             r: Rect;
  96.             rgn: RgnHandle;
  97.     begin
  98.         button_highlighted := highlighted;
  99.         SetPort(dlg);
  100.         if OurTrapAvailable(_DeviceLoop) then begin
  101.             GetDItemRect(dlg, item, r);
  102.             rgn := NewRgn;
  103.             RectRgn(rgn, r);
  104.             HackDeviceLoop(rgn, @ButtonDeviceLoopProc, item, 0);
  105.             DisposeRgn(rgn);
  106.         end else begin
  107.             ButtonDeviceLoopProc(1, 0, nil, item);
  108.         end; (* if *)
  109.     end; (* DrawButton *)
  110.  
  111.     procedure UserItemUpdate (dlg: DialogPtr; item: integer);
  112.     begin
  113.         DrawButton(dlg, item, false);
  114.     end; (* UserItemUpdate *)
  115.  
  116.     function WhatOpenButton (wt: WindowType; item: integer): OSErr;
  117.     begin
  118.         SetDItemHandle(windowinfo[wt].window, item, @UserItemUpdate);
  119.         WhatOpenButton := noErr;
  120.     end; (* WhatOpenButton *)
  121.  
  122.     function WhatClickButton (wt: WindowType; item: integer; er: eventRecord): OSErr;
  123.         var
  124.             dlg: DialogPtr;
  125.             highlighted: boolean;
  126.             mouse_pos: Point;
  127.             r: Rect;
  128.  
  129.         procedure ToggleHighlight;
  130.         begin
  131.             highlighted := not highlighted;
  132.             DrawButton(dlg, item, highlighted);
  133.         end; (* ToggleHighlight *)
  134.  
  135.         var
  136.             err: OSErr;
  137.     begin
  138.         er := er; { Unused }
  139.         dlg := windowinfo[wt].window;
  140.         GetDItemRect(dlg, item, r);
  141.         highlighted := false;
  142.         repeat
  143.             GetMouse(mouse_pos);
  144.             if PtInRect(mouse_pos, r) <> highlighted then begin
  145.                 ToggleHighlight;
  146.             end; (* if *)
  147.         until not StillDown;
  148.         err := noErr;
  149.         if highlighted then begin
  150.             ToggleHighlight;
  151.             err := WindowsOpen(WindowType(ord(WT_Personal) + item - 1));
  152.         end; (* if *)
  153.         WhatClickButton := err;
  154.     end; (* WhatClickButton *)
  155.  
  156. end. (* ICButtonWhat *)
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163. function WhatClickButton (wt: WindowType; item: integer; er: eventRecord): OSErr;
  164.     const
  165.         HiliteMode = $938;
  166.     var
  167.         dlg: DialogPtr;
  168.         r: Rect;
  169.         highlighted: boolean;
  170.         suite: Handle;
  171.         junk: OSErr;
  172.         transfer: integer;
  173.         highlight_rgn: RgnHandle;
  174.         tmp_rgn: RgnHandle;
  175.         icon_rect: Rect;
  176.         mouse_pos: Point;
  177.  
  178.     procedure ToggleHighlight;
  179.     begin
  180.         highlighted := not highlighted;
  181.         if system7 then begin
  182.             if highlighted then begin
  183.                 transfer := ttSelected;
  184.             end else begin
  185.                 transfer := ttNone;
  186.             end; (* if *)
  187.             junk := PlotIconSuite(icon_rect, atNone, transfer, suite);
  188.         end; (* if *)
  189.         if has_colorQD then begin
  190.             BitClr(Ptr(HiliteMode), pHiliteBit);
  191.         end; (* if *)
  192.         InvertRgn(highlight_rgn);
  193.     end; (* ToggleHighlight *)
  194.  
  195.     var
  196.         err: OSErr;
  197. begin
  198.     dlg := windowinfo[wt].window;
  199.     GetIconRect(dlg, item, icon_rect);
  200.     GetDItemRect(dlg, item, r);
  201.     suite := nil;
  202.     highlight_rgn := NewRgn;
  203.     InsetRect(r, 1, 1);
  204.     RectRgn(highlight_rgn, r);
  205.     if system7 then begin
  206.         junk := GetIconSuite(suite, 200 + item, svAllLargeData);
  207.         tmp_rgn := NewRgn;
  208.         junk := IconSuiteToRgn(tmp_rgn, icon_rect, atNone, suite);
  209.         XorRgn(tmp_rgn, highlight_rgn, highlight_rgn);
  210.         DisposeRgn(tmp_rgn);
  211.     end; (* if *)
  212.     highlighted := false;
  213.     while StillDown do begin
  214.         GetMouse(mouse_pos);
  215.         if PtInRect(mouse_pos, r) <> highlighted then begin
  216.             ToggleHighlight;
  217.         end; (* if *)
  218.     end; (* while *)
  219.     err := noErr;
  220.     if highlighted then begin
  221.         ToggleHighlight;
  222.         err := WindowsOpen(WindowType(ord(WT_Personal) + item - 1), 200 + item);
  223.     end; (* if *)
  224.     if suite <> nil then begin
  225.         junk := DisposeIconSuite(suite, false);
  226.     end; (* if *)
  227.     if highlight_rgn <> nil then begin
  228.         DisposeRgn(highlight_rgn);
  229.     end; (* if *)
  230.     WhatClickButton := err;
  231. end; (* WhatClickButton *)